# Utility functions to cooperate with {rtables} package

#' Convert table into matrix of strings

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Helper function to use mostly within tests. `with_spaces`parameter allows

#' to test not only for content but also indentation and table structure.

#' `print_txt_to_copy` instead facilitate the testing development by returning a well

#' formatted text that needs only to be copied and pasted in the expected output.

#'

#' @inheritParams formatters::toString

#' @param x (`VTableTree`)\cr `rtables` table object.

#' @param with_spaces (`flag`)\cr whether the tested table should keep the indentation and other relevant spaces.

#' @param print_txt_to_copy (`flag`)\cr utility to have a way to copy the input table directly

#'   into the expected variable instead of copying it too manually.

#'

#' @return A `matrix` of `string`s. If `print_txt_to_copy = TRUE` the well formatted printout of the

#'   table will be printed to console, ready to be copied as a expected value.

#'

#' @examples

#' tbl <- basic_table() %>%

#'   split_rows_by("SEX") %>%

#'   split_cols_by("ARM") %>%

#'   analyze("AGE") %>%

#'   build_table(tern_ex_adsl)

#'

#' to_string_matrix(tbl, widths = ceiling(propose_column_widths(tbl) / 2))

#'

#' @export

to_string_matrix <- function(x, widths = NULL, max_width = NULL,

                             hsep = formatters::default_hsep(),

                             with_spaces = TRUE, print_txt_to_copy = FALSE) {

  } else {

  }

  }

  # Producing the matrix to test

  } else {

  }

  # Printing to console formatted output that needs to be copied in "expected"

    }

  }

  # Return values

}

#' Blank for missing input

#'

#' Helper function to use in tabulating model results.

#'

#' @param x (`vector`)\cr input for a cell.

#'

#' @return An empty `character` vector if all entries in `x` are missing (`NA`), otherwise

#'   the unlisted version of `x`.

#'

#' @keywords internal

unlist_and_blank_na <- function(x) {

  } else {

  }

}

#' Constructor for content functions given a data frame with flag input

#'

#' This can be useful for tabulating model results.

#'

#' @param analysis_var (`string`)\cr variable name for the column containing values to be returned by the

#'   content function.

#' @param flag_var (`string`)\cr variable name for the logical column identifying which row should be returned.

#' @param format (`string`)\cr `rtables` format to use.

#'

#' @return A content function which gives `df$analysis_var` at the row identified by

#'   `.df_row$flag` in the given format.

#'

#' @keywords internal

cfun_by_flag <- function(analysis_var,

                         flag_var,

                         format = "xx",

                         .indent_mods = NULL) {

    )

  }

}

#' Content row function to add row total to labels

#'

#' This takes the label of the latest row split level and adds the row total from `df` in parentheses.

#' This function differs from [c_label_n_alt()] by taking row counts from `df` rather than

#' `alt_counts_df`, and is used by [add_rowcounts()] when `alt_counts` is set to `FALSE`.

#'

#' @inheritParams argument_convention

#'

#' @return A list with formatted [rtables::CellValue()] with the row count value and the correct label.

#'

#' @note It is important here to not use `df` but rather `.N_row` in the implementation, because

#'   the former is already split by columns and will refer to the first column of the data only.

#'

#' @seealso [c_label_n_alt()] which performs the same function but retrieves row counts from

#'   `alt_counts_df` instead of `df`.

#'

#' @keywords internal

c_label_n <- function(df,

                      labelstr,

                      .N_row) { # nolint

  )

}

#' Content row function to add `alt_counts_df` row total to labels

#'

#' This takes the label of the latest row split level and adds the row total from `alt_counts_df`

#' in parentheses. This function differs from [c_label_n()] by taking row counts from `alt_counts_df`

#' rather than `df`, and is used by [add_rowcounts()] when `alt_counts` is set to `TRUE`.

#'

#' @inheritParams argument_convention

#'

#' @return A list with formatted [rtables::CellValue()] with the row count value and the correct label.

#'

#' @seealso [c_label_n()] which performs the same function but retrieves row counts from `df` instead

#'   of `alt_counts_df`.

#'

#' @keywords internal

c_label_n_alt <- function(df,

                          labelstr,

                          .alt_df_row) {

  )

}

#' Layout-creating function to add row total counts

#'

#' @description `r lifecycle::badge("stable")`

#'

#' This works analogously to [rtables::add_colcounts()] but on the rows. This function

#'  is a wrapper for [rtables::summarize_row_groups()].

#'

#' @inheritParams argument_convention

#' @param alt_counts (`flag`)\cr whether row counts should be taken from `alt_counts_df` (`TRUE`)

#'   or from `df` (`FALSE`). Defaults to `FALSE`.

#'

#' @return A modified layout where the latest row split labels now have the row-wise

#'   total counts (i.e. without column-based subsetting) attached in parentheses.

#'

#' @note Row count values are contained in these row count rows but are not displayed

#'   so that they are not considered zero rows by default when pruning.

#'

#' @examples

#' basic_table() %>%

#'   split_cols_by("ARM") %>%

#'   add_colcounts() %>%

#'   split_rows_by("RACE", split_fun = drop_split_levels) %>%

#'   add_rowcounts() %>%

#'   analyze("AGE", afun = list_wrap_x(summary), format = "xx.xx") %>%

#'   build_table(DM)

#'

#' @export

add_rowcounts <- function(lyt, alt_counts = FALSE) {

  )

}

#' Obtain column indices

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Helper function to extract column indices from a `VTableTree` for a given

#' vector of column names.

#'

#' @param table_tree (`VTableTree`)\cr `rtables` table object to extract the indices from.

#' @param col_names (`character`)\cr vector of column names.

#'

#' @return A vector of column indices.

#'

#' @export

h_col_indices <- function(table_tree, col_names) {

}

#' Labels or names of list elements

#'

#' Internal helper function for working with nested statistic function results which typically

#' don't have labels but names that we can use.

#'

#' @param x (`list`)\cr a list.

#'

#' @return A `character` vector with the labels or names for the list elements.

#'

#' @keywords internal

labels_or_names <- function(x) {

}

#' Convert to `rtable`

#'

#' @description `r lifecycle::badge("stable")`

#'

#' This is a new generic function to convert objects to `rtable` tables.

#'

#' @param x (`data.frame`)\cr the object which should be converted to an `rtable`.

#' @param ... additional arguments for methods.

#'

#' @return An `rtables` table object. Note that the concrete class will depend on the method used.

#'

#' @export

as.rtable <- function(x, ...) { # nolint

}

#' @describeIn as.rtable Method for converting a `data.frame` that contains numeric columns to `rtable`.

#'

#' @param format (`string` or `function`)\cr the format which should be used for the columns.

#'

#' @method as.rtable data.frame

#'

#' @examples

#' x <- data.frame(

#'   a = 1:10,

#'   b = rnorm(10)

#' )

#' as.rtable(x)

#'

#' @export

as.rtable.data.frame <- function(x, format = "xx.xx", ...) {

      ),

            )

          )

        },

      )

    )

  )

}

#' Split parameters

#'

#' @description `r lifecycle::badge("deprecated")`

#'

#' It divides the data in the vector `param` into the groups defined by `f` based on specified `values`. It is relevant

#' in `rtables` layers so as to distribute parameters `.stats` or' `.formats` into lists with items corresponding to

#' specific analysis function.

#'

#' @param param (`vector`)\cr the parameter to be split.

#' @param value (`vector`)\cr the value used to split.

#' @param f (`list`)\cr the reference to make the split.

#'

#' @return A named `list` with the same element names as `f`, each containing the elements specified in `.stats`.

#'

#' @examples

#' f <- list(

#'   surv = c("pt_at_risk", "event_free_rate", "rate_se", "rate_ci"),

#'   surv_diff = c("rate_diff", "rate_diff_ci", "ztest_pval")

#' )

#'

#' .stats <- c("pt_at_risk", "rate_diff")

#' h_split_param(.stats, .stats, f = f)

#'

#' # $surv

#' # [1] "pt_at_risk"

#' #

#' # $surv_diff

#' # [1] "rate_diff"

#'

#' .formats <- c("pt_at_risk" = "xx", "event_free_rate" = "xxx")

#' h_split_param(.formats, names(.formats), f = f)

#'

#' # $surv

#' # pt_at_risk event_free_rate

#' # "xx"           "xxx"

#' #

#' # $surv_diff

#' # NULL

#'

#' @export

h_split_param <- function(param,

                          value,

                          f) {

}

#' Get selected statistics names

#'

#' Helper function to be used for creating `afun`.

#'

#' @param .stats (`vector` or `NULL`)\cr input to the layout creating function. Note that `NULL` means

#'   in this context that all default statistics should be used.

#' @param all_stats (`character`)\cr all statistics which can be selected here potentially.

#'

#' @return A `character` vector with the selected statistics.

#'

#' @keywords internal

afun_selected_stats <- function(.stats, all_stats) {

  } else {

  }

}

#' Add variable labels to top left corner in table

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Helper layout-creating function to append the variable labels of a given variables vector

#' from a given dataset in the top left corner. If a variable label is not found then the

#' variable name itself is used instead. Multiple variable labels are concatenated with slashes.

#'

#' @inheritParams argument_convention

#' @param vars (`character`)\cr variable names of which the labels are to be looked up in `df`.

#' @param indent (`integer(1)`)\cr non-negative number of nested indent space, default to 0L which means no indent.

#'   1L means two spaces indent, 2L means four spaces indent and so on.

#'

#' @return A modified layout with the new variable label(s) added to the top-left material.

#'

#' @note This is not an optimal implementation of course, since we are using here the data set

#'   itself during the layout creation. When we have a more mature `rtables` implementation then

#'   this will also be improved or not necessary anymore.

#'

#' @examples

#' lyt <- basic_table() %>%

#'   split_cols_by("ARM") %>%

#'   add_colcounts() %>%

#'   split_rows_by("SEX") %>%

#'   append_varlabels(DM, "SEX") %>%

#'   analyze("AGE", afun = mean) %>%

#'   append_varlabels(DM, "AGE", indent = 1)

#' build_table(lyt, DM)

#'

#' lyt <- basic_table() %>%

#'   split_cols_by("ARM") %>%

#'   split_rows_by("SEX") %>%

#'   analyze("AGE", afun = mean) %>%

#'   append_varlabels(DM, c("SEX", "AGE"))

#' build_table(lyt, DM)

#'

#' @export

append_varlabels <- function(lyt, df, vars, indent = 0L) {

  }

}

#' Default string replacement for `NA` values

#'

#' @description `r lifecycle::badge("stable")`

#'

#' The default string used to represent `NA` values. This value is used as the default

#' value for the `na_str` argument throughout the `tern` package, and printed in place

#' of `NA` values in output tables. If not specified for each `tern` function by the user

#' via the `na_str` argument, or in the R environment options via [set_default_na_str()],

#' then `NA` is used.

#'

#' @param na_str (`string`)\cr single string value to set in the R environment options as

#'   the default value to replace `NA`s. Use `getOption("tern_default_na_str")` to check the

#'   current value set in the R environment (defaults to `NULL` if not set).

#'

#' @name default_na_str

NULL

#' @describeIn default_na_str Accessor for default `NA` value replacement string.

#'

#' @return

#' * `default_na_str` returns the current value if an R environment option has been set

#'   for `"tern_default_na_str"`, or `NA_character_` otherwise.

#'

#' @examples

#' # Default settings

#' default_na_str()

#' getOption("tern_default_na_str")

#'

#' # Set custom value

#' set_default_na_str("<Missing>")

#'

#' # Settings after value has been set

#' default_na_str()

#' getOption("tern_default_na_str")

#'

#' @export

default_na_str <- function() {

}

#' @describeIn default_na_str Setter for default `NA` value replacement string. Sets the

#'   option `"tern_default_na_str"` within the R environment.

#'

#' @return

#' * `set_default_na_str` has no return value.

#'

#' @export

set_default_na_str <- function(na_str) {

}

#' Utilities to handle extra arguments in analysis functions

#'

#' @description `r lifecycle::badge("stable")`

#' Important additional parameters, useful to modify behavior of analysis and summary

#' functions are listed in [rtables::additional_fun_params]. With these utility functions

#' we can retrieve a curated list of these parameters from the environment, and pass them

#' to the analysis functions with dedicated `...`; notice that the final `s_*` function

#' will get them through argument matching.

#'

#' @param extra_afun_params (`list`)\cr list of additional parameters (`character`) to be

#'   retrieved from the environment. Curated list is present in [rtables::additional_fun_params].

#' @param add_alt_df (`logical`)\cr if `TRUE`, the function will also add `.alt_df` and `.alt_df_row`

#'   parameters.

#'

#' @name util_handling_additional_fun_params

NULL

#' @describeIn util_handling_additional_fun_params Retrieve additional parameters from the environment.

#'

#' @return

#' * `retrieve_extra_afun_params` returns a list of the values of the parameters in the environment.

#'

#' @keywords internal

retrieve_extra_afun_params <- function(extra_afun_params) {

  }

}

#' @describeIn util_handling_additional_fun_params Curated list of additional parameters for

#'   analysis functions. Please check [rtables::additional_fun_params] for precise descriptions.

#'

#' @return

#' * `get_additional_afun_params` returns a list of additional parameters.

#'

#' @keywords internal

get_additional_afun_params <- function(add_alt_df = FALSE) {

  )

    )

  }

}

#' Get default statistical methods and their associated formats, labels, and indent modifiers

#'

#' @description `r lifecycle::badge("experimental")`

#'

#' Utility functions to get valid statistic methods for different method groups

#' (`.stats`) and their associated formats (`.formats`), labels (`.labels`), and indent modifiers

#' (`.indent_mods`). This utility is used across `tern`, but some of its working principles can be

#' seen in [analyze_vars()]. See notes to understand why this is experimental.

#'

#' @param stats (`character`)\cr statistical methods to return defaults for.

#' @param levels_per_stats (named `list` of `character` or `NULL`)\cr named list where the name of each element is a

#'   statistic from `stats` and each element is the levels of a `factor` or `character` variable (or variable name),

#'   each corresponding to a single row, for which the named statistic should be calculated for. If a statistic is only

#'   calculated once (one row), the element can be either `NULL` or the name of the statistic. Each list element will be

#'   flattened such that the names of the list elements returned by the function have the format `statistic.level` (or

#'   just `statistic` for statistics calculated for a single row). Defaults to `NULL`.

#' @param tern_defaults (`list` or `vector`)\cr defaults to use to fill in missing values if no user input is given.

#'   Must be of the same type as the values that are being filled in (e.g. indentation must be integers).

#'

#' @details

#' Current choices for `type` are `counts` and `numeric` for [analyze_vars()] and affect `get_stats()`.

#'

#' @note

#' These defaults are experimental because we use the names of functions to retrieve the default

#' statistics. This should be generalized in groups of methods according to more reasonable groupings.

#'

#' @name default_stats_formats_labels

NULL

#' @describeIn default_stats_formats_labels Get statistics available for a given method

#'   group (analyze function). To check available defaults see `tern::tern_default_stats` list.

#'

#' @param method_groups (`character`)\cr indicates the statistical method group (`tern` analyze function)

#'   to retrieve default statistics for. A character vector can be used to specify more than one statistical

#'   method group.

#' @param stats_in (`character`)\cr statistics to retrieve for the selected method group. If custom statistical

#'   functions are used, `stats_in` needs to have them in too.

#' @param custom_stats_in (`character`)\cr custom statistics to add to the default statistics.

#' @param add_pval (`flag`)\cr should `"pval"` (or `"pval_counts"` if `method_groups` contains

#'   `"analyze_vars_counts"`) be added to the statistical methods?

#'

#' @return

#' * `get_stats()` returns a `character` vector of statistical methods.

#'

#' @examples

#' # analyze_vars is numeric

#' num_stats <- get_stats("analyze_vars_numeric") # also the default

#'

#' # Other type

#' cnt_stats <- get_stats("analyze_vars_counts")

#'

#' # Weirdly taking the pval from count_occurrences

#' only_pval <- get_stats("count_occurrences", add_pval = TRUE, stats_in = "pval")

#'

#' # All count_occurrences

#' all_cnt_occ <- get_stats("count_occurrences")

#'

#' # Multiple

#' get_stats(c("count_occurrences", "analyze_vars_counts"))

#'

#' @export

get_stats <- function(method_groups = "analyze_vars_numeric",

                      stats_in = NULL, custom_stats_in = NULL, add_pval = FALSE) {

  # Default is still numeric

  }

  # Defaults for loop

  # Loop for multiple method groups

    } else {

    }

  }

  # Add custom stats

  # If you added pval to the stats_in you certainly want it

    # Must be only one value between choices

    # Mismatch with counts and numeric

      )

    }

    # Lets add it even if present (thanks to unique)

  }

  # Mainly used in "analyze_vars" but it could be necessary elsewhere

    } else {

    }

  }

  # Filtering for stats_in (character vector)

  }

  # If intersect did not find matches (and no pval?) -> error

    )

  }

}

#' @describeIn default_stats_formats_labels Get statistical *names* available for a given method

#'   group (analyze function). Please use the `s_*` functions to get the statistical names.

#' @param stat_results (`list`)\cr list of statistical results. It should be used close to the end of

#'   a statistical function. See examples for a structure with two statistical results and two groups.

#' @param stat_names_in (`character`)\cr custom modification of statistical values.

#'

#' @return

#' * `get_stat_names()` returns a named list of`character` vectors, indicating the names of

#'    statistical outputs.

#'

#' @examples

#' stat_results <- list(

#'   "n" = list("M" = 1, "F" = 2),

#'   "count_fraction" = list("M" = c(1, 0.2), "F" = c(2, 0.1))

#' )

#' get_stat_names(stat_results)

#' get_stat_names(stat_results, list("n" = "argh"))

#'

#' @export

get_stat_names <- function(stat_results, stat_names_in = NULL) {

    }

  })

  # Modify some with custom stat names

    # Stats is the main

  }

}

# Utility function used to separate custom stats (user-defined functions) from defaults

.split_std_from_custom_stats <- function(stats_in) {

  } else {

  }

}

# Utility function to apply statistical functions

.apply_stat_functions <- function(default_stat_fnc, custom_stat_fnc_list, args_list) {

  # Default checks

  # Checking custom stats have same formals

        )

      }

        )

      }

    }

  }

  # Merging

  # Applying

}

#' @describeIn default_stats_formats_labels Get formats corresponding to a list of statistics.

#'   To check available defaults see list `tern::tern_default_formats`.

#'

#' @param formats_in (named `vector`)\cr custom formats to use instead of defaults. Can be a character vector with

#'   values from [formatters::list_valid_format_labels()] or custom format functions. Defaults to `NULL` for any rows

#'   with no value is provided.

#'

#' @return

#' * `get_formats_from_stats()` returns a named list of formats as strings or functions.

#'

#' @note Formats in `tern` and `rtables` can be functions that take in the table cell value and

#'   return a string. This is well documented in `vignette("custom_appearance", package = "rtables")`.

#'

#' @examples

#' # Defaults formats

#' get_formats_from_stats(num_stats)

#' get_formats_from_stats(cnt_stats)

#' get_formats_from_stats(only_pval)

#' get_formats_from_stats(all_cnt_occ)

#'

#' # Addition of customs

#' get_formats_from_stats(all_cnt_occ, formats_in = c("fraction" = c("xx")))

#' get_formats_from_stats(all_cnt_occ, formats_in = list("fraction" = c("xx.xx", "xx")))

#'

#' @seealso [formatting_functions]

#'

#' @export

get_formats_from_stats <- function(stats,

                                   formats_in = NULL,

                                   levels_per_stats = NULL,

                                   tern_defaults = tern_default_formats) {

  # It may be a list if there is a function in the formats

    # Or it may be a vector of characters

  } else {

  }

  # If levels_per_stats not given, assume one row per statistic

  # Apply custom formats

  # Default to NULL if no format

}

#' @describeIn default_stats_formats_labels Get labels corresponding to a list of statistics.

#'   To check for available defaults see list `tern::tern_default_labels`.

#'

#' @param labels_in (named `character`)\cr custom labels to use instead of defaults. If no value is provided, the

#'   variable level (if rows correspond to levels of a variable) or statistic name will be used as label.

#'

#' @return

#' * `get_labels_from_stats()` returns a named list of labels as strings.

#'

#' @examples

#' # Defaults labels

#' get_labels_from_stats(num_stats)

#' get_labels_from_stats(cnt_stats)

#' get_labels_from_stats(only_pval)

#' get_labels_from_stats(all_cnt_occ)

#'

#' # Addition of customs

#' get_labels_from_stats(all_cnt_occ, labels_in = c("fraction" = "Fraction"))

#' get_labels_from_stats(all_cnt_occ, labels_in = list("fraction" = c("Some more fractions")))

#'

#' @export

get_labels_from_stats <- function(stats,

                                  labels_in = NULL,

                                  levels_per_stats = NULL,

                                  tern_defaults = tern_default_labels) {

  # It may be a list

    # Or it may be a vector of characters

  } else {

  }

  # If levels_per_stats not given, assume one row per statistic

  # Apply custom labels

}

#' @describeIn default_stats_formats_labels Get row indent modifiers corresponding to a list of statistics/rows.

#'

#' @param indents_in (named `integer`)\cr custom row indent modifiers to use instead of defaults. Defaults to `0L` for

#'   all values.

#' @param row_nms `r lifecycle::badge("deprecated")` Deprecation cycle started. See the `levels_per_stats` parameter

#'   for details.

#'

#' @return

#' * `get_indents_from_stats()` returns a named list of indentation modifiers as integers.

#'

#' @examples

#' get_indents_from_stats(all_cnt_occ, indents_in = 3L)

#' get_indents_from_stats(all_cnt_occ, indents_in = list(count = 2L, count_fraction = 5L))

#' get_indents_from_stats(

#'   all_cnt_occ,

#'   indents_in = list(a = 2L, count.a = 1L, count.b = 5L)

#' )

#'

#' @export

get_indents_from_stats <- function(stats,

                                   indents_in = NULL,

                                   levels_per_stats = NULL,

                                   tern_defaults = as.list(rep(0L, length(stats))) %>% setNames(stats),

                                   row_nms = lifecycle::deprecated()) {

  # It may be a list

    # Or it may be a vector of integers

  } else {

  }

  # If levels_per_stats not given, assume one row per statistic

  # Single indentation level for all rows

  }

  # Apply custom indentation

}

# Function to loop over each stat and levels to set correct values

.fill_in_vals_by_stats <- function(levels_per_stats, user_in, tern_defaults) {

    # Get all levels of the statistic

      }

    } else { # One row per combination of variable level and statistic

      # Loop over levels for each statistic

        # Construct row name (stat_i.lev_i)

        }

      }

    }

  }

}

# Custom unlist function to retain NULL as "NULL" or NA

.unlist_keep_nulls <- function(lst, null_placeholder = "NULL", recursive = FALSE) {

}

#' Update labels according to control specifications

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Given a list of statistic labels and and a list of control parameters, updates labels with a relevant

#' control specification. For example, if control has element `conf_level` set to `0.9`, the default

#' label for statistic `mean_ci` will be updated to `"Mean 90% CI"`. Any labels that are supplied

#' via `labels_custom` will not be updated regardless of `control`.

#'

#' @param labels_default (named `character`)\cr a named vector of statistic labels to modify

#'   according to the control specifications. Labels that are explicitly defined in `labels_custom` will

#'   not be affected.

#' @param labels_custom (named `character`)\cr named vector of labels that are customized by

#'   the user and should not be affected by `control`.

#' @param control (named `list`)\cr list of control parameters to apply to adjust default labels.

#'

#' @return A named character vector of labels with control specifications applied to relevant labels.

#'

#' @examples

#' control <- list(conf_level = 0.80, quantiles = c(0.1, 0.83), test_mean = 0.57)

#' get_labels_from_stats(c("mean_ci", "quantiles", "mean_pval")) %>%

#'   labels_use_control(control = control)

#'

#' @export

labels_use_control <- function(labels_default, control, labels_custom = NULL) {

        } else {

        }

      }

    )

  }

    )

  }

    )

  }

    )

  }

    )

  }

}

# tern_default_stats -----------------------------------------------------------

#' @describeIn default_stats_formats_labels Named list of available statistics by method group for `tern`.

#'

#' @format

#' * `tern_default_stats` is a named list of available statistics, with each element

#'   named for their corresponding statistical method group.

#'

#' @export

tern_default_stats <- list(

  abnormal = c("fraction"),

  abnormal_by_baseline = c("fraction"),

  abnormal_by_marked = c("count_fraction", "count_fraction_fixed_dp"),

  abnormal_by_worst_grade = c("count_fraction", "count_fraction_fixed_dp"),

  abnormal_lab_worsen_by_baseline = c("fraction"),

  analyze_patients_exposure_in_cols = c("n_patients", "sum_exposure"),

  analyze_vars_counts = c("n", "count", "count_fraction", "count_fraction_fixed_dp", "fraction", "n_blq"),

  analyze_vars_numeric = c(

    "n", "sum", "mean", "sd", "se", "mean_sd", "mean_se", "mean_ci", "mean_sei", "mean_sdi", "mean_pval",

    "median", "mad", "median_ci", "quantiles", "iqr", "range", "min", "max", "median_range", "cv",

    "geom_mean", "geom_sd", "geom_mean_sd", "geom_mean_ci", "geom_cv",

    "median_ci_3d",

    "mean_ci_3d", "geom_mean_ci_3d"

  ),

  count_cumulative = c("count_fraction", "count_fraction_fixed_dp"),

  count_missed_doses = c("n", "count_fraction", "count_fraction_fixed_dp"),

  count_occurrences = c("count", "count_fraction", "count_fraction_fixed_dp", "fraction"),

  count_occurrences_by_grade = c("count_fraction", "count_fraction_fixed_dp"),

  count_patients_with_event = c("n", "count", "count_fraction", "count_fraction_fixed_dp", "n_blq"),

  count_patients_with_flags = c("n", "count", "count_fraction", "count_fraction_fixed_dp", "n_blq"),

  count_values = c("n", "count", "count_fraction", "count_fraction_fixed_dp", "n_blq"),

  coxph_pairwise = c("pvalue", "hr", "hr_ci", "n_tot", "n_tot_events"),

  estimate_incidence_rate = c("person_years", "n_events", "rate", "rate_ci", "n_unique", "n_rate"),

  estimate_multinomial_response = c("n_prop", "prop_ci"),

  estimate_odds_ratio = c("or_ci", "n_tot"),

  estimate_proportion = c("n_prop", "prop_ci"),

  estimate_proportion_diff = c("diff", "diff_ci"),

  summarize_ancova = c("n", "lsmean", "lsmean_diff", "lsmean_diff_ci", "pval"),

  summarize_coxreg = c("n", "hr", "ci", "pval", "pval_inter"),

  summarize_glm_count = c("n", "rate", "rate_ci", "rate_ratio", "rate_ratio_ci", "pval"),

  summarize_num_patients = c("unique", "nonunique", "unique_count"),

  summarize_patients_events_in_cols = c("unique", "all"),

  surv_time = c(

    "median", "median_ci", "median_ci_3d", "quantiles",

    "quantiles_lower", "quantiles_upper", "range_censor", "range_event", "range"

  ),

  surv_timepoint = c("pt_at_risk", "event_free_rate", "rate_se", "rate_ci", "event_free_rate_3d"),

  surv_timepoint_diff = c("rate_diff", "rate_diff_ci", "ztest_pval", "rate_diff_ci_3d"),

  tabulate_rsp_biomarkers = c("n_tot", "n_rsp", "prop", "or", "ci", "pval"),

  tabulate_rsp_subgroups = c("n", "n_rsp", "prop", "n_tot", "or", "ci", "pval"),

  tabulate_survival_biomarkers = c("n_tot", "n_tot_events", "median", "hr", "ci", "pval"),

  tabulate_survival_subgroups = c("n_tot_events", "n_events", "n_tot", "n", "median", "hr", "ci", "pval"),

  test_proportion_diff = c("pval")

)

# tern_default_formats ---------------------------------------------------------

#' @describeIn default_stats_formats_labels Named vector of default formats for `tern`.

#'

#' @format

#' * `tern_default_formats` is a named vector of available default formats, with each element

#'   named for their corresponding statistic.

#'

#' @export

tern_default_formats <- c(

  fraction = format_fraction_fixed_dp,

  unique = format_count_fraction_fixed_dp,

  nonunique = "xx",

  unique_count = "xx",

  n = "xx.",

  count = "xx.",

  count_fraction = format_count_fraction,

  count_fraction_fixed_dp = format_count_fraction_fixed_dp,

  n_blq = "xx.",

  sum = "xx.x",

  mean = "xx.x",

  sd = "xx.x",

  se = "xx.x",

  mean_sd = "xx.x (xx.x)",

  mean_se = "xx.x (xx.x)",

  mean_ci = "(xx.xx, xx.xx)",

  mean_sei = "(xx.xx, xx.xx)",

  mean_sdi = "(xx.xx, xx.xx)",

  mean_pval = "x.xxxx | (<0.0001)",

  mean_ci_3d = "xx.xx (xx.xx - xx.xx)",

  median = "xx.x",

  mad = "xx.x",

  median_ci = "(xx.xx, xx.xx)",

  median_ci_3d = "xx.xx (xx.xx - xx.xx)",

  quantiles = "xx.x - xx.x",

  quantiles_lower = "xx.xx (xx.xx - xx.xx)",

  quantiles_upper = "xx.xx (xx.xx - xx.xx)",

  iqr = "xx.x",

  range = "xx.x - xx.x",

  min = "xx.x",

  max = "xx.x",

  median_range = "xx.x (xx.x - xx.x)",

  cv = "xx.x",

  geom_mean = "xx.x",

  geom_sd = "xx.x",

  geom_mean_sd = "xx.x (xx.x)",

  geom_mean_ci = "(xx.xx, xx.xx)",

  geom_mean_ci_3d = "xx.xx (xx.xx - xx.xx)",

  geom_cv = "xx.x",

  pval = "x.xxxx | (<0.0001)",

  pval_counts = "x.xxxx | (<0.0001)",

  pvalue = "x.xxxx | (<0.0001)",

  range_censor = "xx.x to xx.x",

  range_event = "xx.x to xx.x",

  rate = "xx.xxxx",

  rate_ci = "(xx.xxxx, xx.xxxx)",

  rate_ratio = "xx.xxxx",

  rate_ratio_ci = "(xx.xxxx, xx.xxxx)",

  rate_diff = "xx.xx",

  rate_diff_ci = "(xx.xx, xx.xx)",

  rate_diff_ci_3d = format_xx("xx.xx (xx.xx, xx.xx)"),

  lsmean = "xx.xx",

  lsmean_diff = "xx.xx",

  lsmean_diff_ci = "(xx.xx, xx.xx)",

  ztest_pval = "x.xxxx | (<0.0001)",

  hr = "xx.xx",

  hr_ci = "(xx.xx, xx.xx)",

  hr_ci_3d = "xx.xx (xx.xx - xx.xx)",

  n_tot = "xx.xx",

  n_tot_events = "xx.xx",

  or_ci = "xx.xx (xx.xx - xx.xx)",

  n_prop = "xx (xx.x%)",

  prop_ci = "(xx.x, xx.x)",

  pt_at_risk = "xx",

  event_free_rate = "xx.xx",

  rate_se = "xx.xx"

)

# tern_default_labels ----------------------------------------------------------

#' @describeIn default_stats_formats_labels Named `character` vector of default labels for `tern`.

#'

#' @format

#' * `tern_default_labels` is a named `character` vector of available default labels, with each element

#'   named for their corresponding statistic.

#'

#' @export

tern_default_labels <- c(

  unique = "Number of patients with at least one event",

  nonunique = "Number of events",

  n = "n",

  n_blq = "n_blq",

  sum = "Sum",

  mean = "Mean",

  sd = "SD",

  se = "SE",

  mean_sd = "Mean (SD)",

  mean_se = "Mean (SE)",

  mean_ci = "Mean 95% CI",

  mean_sei = "Mean -/+ 1xSE",

  mean_sdi = "Mean -/+ 1xSD",

  mean_pval = "Mean p-value (H0: mean = 0)",

  mean_ci_3d = "Mean (95% CI)",

  median = "Median",

  mad = "Median Absolute Deviation",

  median_ci = "Median 95% CI",

  median_ci_3d = "Median (95% CI)",

  quantiles = "25% and 75%-ile",

  quantiles_lower = "25%-ile (95% CI)",

  quantiles_upper = "75%-ile (95% CI)",

  iqr = "IQR",

  range = "Min - Max",

  min = "Minimum",

  max = "Maximum",

  median_range = "Median (Min - Max)",

  cv = "CV (%)",

  geom_mean = "Geometric Mean",

  geom_sd = "Geometric SD",

  geom_mean_sd = "Geometric Mean (SD)",

  geom_mean_ci = "Geometric Mean 95% CI",

  geom_mean_ci_3d = "Geometric Mean (95% CI)",

  geom_cv = "CV % Geometric Mean",

  pval = "p-value (t-test)", # Default for numeric

  pval_counts = "p-value (chi-squared test)", # Default for counts

  rate = "Adjusted Rate",

  rate_ratio = "Adjusted Rate Ratio"

)

#' @describeIn default_stats_formats_labels Quick function to retrieve default formats for summary statistics:

#'   [analyze_vars()] and [analyze_vars_in_cols()] principally.

#'

#' @param type (`string`)\cr `"numeric"` or `"counts"`.

#'

#' @return

#' * `summary_formats()` returns a named `vector` of default statistic formats for the given data type.

#'

#' @examples

#' summary_formats()

#' summary_formats(type = "counts", include_pval = TRUE)

#'

#' @export

summary_formats <- function(type = "numeric", include_pval = FALSE) {

}

#' @describeIn default_stats_formats_labels Quick function to retrieve default labels for summary statistics.

#'   Returns labels of descriptive statistics which are understood by `rtables`. Similar to `summary_formats`.

#'

#' @param include_pval (`flag`)\cr same as the `add_pval` argument in [get_stats()].

#'

#' @details

#' `summary_*` quick get functions for labels or formats uses `get_stats` and `get_labels_from_stats` or

#' `get_formats_from_stats` respectively to retrieve relevant information.

#'

#' @return

#' * `summary_labels` returns a named `vector` of default statistic labels for the given data type.

#'

#' @examples

#' summary_labels()

#' summary_labels(type = "counts", include_pval = TRUE)

#'

#' @export

summary_labels <- function(type = "numeric", include_pval = FALSE) {

}

#' Cox proportional hazards regression

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Fits a Cox regression model and estimates hazard ratio to describe the effect size in a survival analysis.

#'

#' @inheritParams argument_convention

#' @param .stats (`character`)\cr statistics to select for the table.

#'

#'   Options are: ``r shQuote(get_stats("summarize_coxreg"), type = "sh")``

#'

#' @details Cox models are the most commonly used methods to estimate the magnitude of

#'   the effect in survival analysis. It assumes proportional hazards: the ratio

#'   of the hazards between groups (e.g., two arms) is constant over time.

#'   This ratio is referred to as the "hazard ratio" (HR) and is one of the

#'   most commonly reported metrics to describe the effect size in survival

#'   analysis (NEST Team, 2020).

#'

#' @seealso [fit_coxreg] for relevant fitting functions, [h_cox_regression] for relevant

#'   helper functions, and [tidy_coxreg] for custom tidy methods.

#'

#' @examples

#' library(survival)

#'

#' # Testing dataset [survival::bladder].

#' set.seed(1, kind = "Mersenne-Twister")

#' dta_bladder <- with(

#'   data = bladder[bladder$enum < 5, ],

#'   tibble::tibble(

#'     TIME = stop,

#'     STATUS = event,

#'     ARM = as.factor(rx),

#'     COVAR1 = as.factor(enum) %>% formatters::with_label("A Covariate Label"),

#'     COVAR2 = factor(

#'       sample(as.factor(enum)),

#'       levels = 1:4, labels = c("F", "F", "M", "M")

#'     ) %>% formatters::with_label("Sex (F/M)")

#'   )

#' )

#' dta_bladder$AGE <- sample(20:60, size = nrow(dta_bladder), replace = TRUE)

#' dta_bladder$STUDYID <- factor("X")

#'

#' u1_variables <- list(

#'   time = "TIME", event = "STATUS", arm = "ARM", covariates = c("COVAR1", "COVAR2")

#' )

#'

#' u2_variables <- list(time = "TIME", event = "STATUS", covariates = c("COVAR1", "COVAR2"))

#'

#' m1_variables <- list(

#'   time = "TIME", event = "STATUS", arm = "ARM", covariates = c("COVAR1", "COVAR2")

#' )

#'

#' m2_variables <- list(time = "TIME", event = "STATUS", covariates = c("COVAR1", "COVAR2"))

#'

#' @name cox_regression

#' @order 1

NULL

#' @describeIn cox_regression Statistics function that transforms results tabulated

#'   from [fit_coxreg_univar()] or [fit_coxreg_multivar()] into a list.

#'

#' @param model_df (`data.frame`)\cr contains the resulting model fit from a [fit_coxreg]

#'   function with tidying applied via [broom::tidy()].

#' @param .stats (`character`)\cr the names of statistics to be reported among:

#'   * `n`: number of observations (univariate only)

#'   * `hr`: hazard ratio

#'   * `ci`: confidence interval

#'   * `pval`: p-value of the treatment effect

#'   * `pval_inter`: p-value of the interaction effect between the treatment and the covariate (univariate only)

#' @param .which_vars (`character`)\cr which rows should statistics be returned for from the given model.

#'   Defaults to `"all"`. Other options include `"var_main"` for main effects, `"inter"` for interaction effects,

#'   and `"multi_lvl"` for multivariate model covariate level rows. When `.which_vars` is `"all"`, specific

#'   variables can be selected by specifying `.var_nms`.

#' @param .var_nms (`character`)\cr the `term` value of rows in `df` for which `.stats` should be returned. Typically

#'   this is the name of a variable. If using variable labels, `var` should be a vector of both the desired

#'   variable name and the variable label in that order to see all `.stats` related to that variable. When `.which_vars`

#'   is `"var_main"`, `.var_nms` should be only the variable name.

#'

#' @return

#' * `s_coxreg()` returns the selected statistic for from the Cox regression model for the selected variable(s).

#'

#' @examples

#' # s_coxreg

#'

#' # Univariate

#' univar_model <- fit_coxreg_univar(variables = u1_variables, data = dta_bladder)

#' df1 <- broom::tidy(univar_model)

#'

#' s_coxreg(model_df = df1, .stats = "hr")

#'

#' # Univariate with interactions

#' univar_model_inter <- fit_coxreg_univar(

#'   variables = u1_variables, control = control_coxreg(interaction = TRUE), data = dta_bladder

#' )

#' df1_inter <- broom::tidy(univar_model_inter)

#'

#' s_coxreg(model_df = df1_inter, .stats = "hr", .which_vars = "inter", .var_nms = "COVAR1")

#'

#' # Univariate without treatment arm - only "COVAR2" covariate effects

#' univar_covs_model <- fit_coxreg_univar(variables = u2_variables, data = dta_bladder)

#' df1_covs <- broom::tidy(univar_covs_model)

#'

#' s_coxreg(model_df = df1_covs, .stats = "hr", .var_nms = c("COVAR2", "Sex (F/M)"))

#'

#' # Multivariate.

#' multivar_model <- fit_coxreg_multivar(variables = m1_variables, data = dta_bladder)

#' df2 <- broom::tidy(multivar_model)

#'

#' s_coxreg(model_df = df2, .stats = "pval", .which_vars = "var_main", .var_nms = "COVAR1")

#' s_coxreg(

#'   model_df = df2, .stats = "pval", .which_vars = "multi_lvl",

#'   .var_nms = c("COVAR1", "A Covariate Label")

#' )

#'

#' # Multivariate without treatment arm - only "COVAR1" main effect

#' multivar_covs_model <- fit_coxreg_multivar(variables = m2_variables, data = dta_bladder)

#' df2_covs <- broom::tidy(multivar_covs_model)

#'

#' s_coxreg(model_df = df2_covs, .stats = "hr")

#'

#' @export

s_coxreg <- function(model_df, .stats, .which_vars = "all", .var_nms = NULL) {

  # We need a list with names corresponding to the stats to display of equal length to the list of stats.

  }

    }

  )

}

#' @describeIn cox_regression Analysis function which is used as `afun` in [rtables::analyze()]

#'   and `cfun` in [rtables::summarize_row_groups()] within `summarize_coxreg()`.

#'

#' @param eff (`flag`)\cr whether treatment effect should be calculated. Defaults to `FALSE`.

#' @param var_main (`flag`)\cr whether main effects should be calculated. Defaults to `FALSE`.

#' @param na_str (`string`)\cr custom string to replace all `NA` values with. Defaults to `""`.

#' @param cache_env (`environment`)\cr an environment object used to cache the regression model in order to

#'   avoid repeatedly fitting the same model for every row in the table. Defaults to `NULL` (no caching).

#' @param varlabels (`list`)\cr a named list corresponds to the names of variables found in data, passed

#'   as a named list and corresponding to time, event, arm, strata, and covariates terms. If arm is missing

#'   from variables, then only Cox model(s) including the covariates will be fitted and the corresponding

#'   effect estimates will be tabulated later.

#'

#' @return

#' * `a_coxreg()` returns formatted [rtables::CellValue()].

#'

#' @examples

#' a_coxreg(

#'   df = dta_bladder,

#'   labelstr = "Label 1",

#'   variables = u1_variables,

#'   .spl_context = list(value = "COVAR1"),

#'   .stats = "n",

#'   .formats = "xx"

#' )

#'

#' a_coxreg(

#'   df = dta_bladder,

#'   labelstr = "",

#'   variables = u1_variables,

#'   .spl_context = list(value = "COVAR2"),

#'   .stats = "pval",

#'   .formats = "xx.xxxx"

#' )

#'

#' @export

a_coxreg <- function(df,

                     labelstr,

                     eff = FALSE,

                     var_main = FALSE,

                     multivar = FALSE,

                     variables,

                     at = list(),

                     control = control_coxreg(),

                     .spl_context,

                     .stats,

                     .formats,

                     .indent_mods = NULL,

                     na_str = "",

                     cache_env = NULL) {

  }

  } else {

  }

    } else {

    }

  } else {

  }

  }

    } else { # treatment effect

    }

  } else {

    }

  }

  } else {

  }

  )

}

#' @describeIn cox_regression Layout-creating function which creates a Cox regression summary table

#'   layout. This function is a wrapper for several `rtables` layouting functions. This function

#'   is a wrapper for [rtables::analyze_colvars()] and [rtables::summarize_row_groups()].

#'

#' @inheritParams fit_coxreg_univar

#' @param multivar (`flag`)\cr whether multivariate Cox regression should run (defaults to `FALSE`), otherwise

#'   univariate Cox regression will run.

#' @param common_var (`string`)\cr the name of a factor variable in the dataset which takes the same value

#'   for all rows. This should be created during pre-processing if no such variable currently exists.

#' @param .section_div (`string` or `NA`)\cr string which should be repeated as a section divider between sections.

#'   Defaults to `NA` for no section divider. If a vector of two strings are given, the first will be used between

#'   treatment and covariate sections and the second between different covariates.

#'

#' @return

#' * `summarize_coxreg()` returns a layout object suitable for passing to further layouting functions,